Tabla de contenido

  1. Introducción

    1.1. Motivación

    1.2. Metodología

  2. Desarrollo

    2.1. Identificación del problema

    2.2. Identificación de los datos

    2.3. Descripción de los datos

    2.3.1. Limpieza y resumen
    2.3.2. Análisis de los datos
    2.3.3. Tratamiento de datos atípicos

    2.4. Modelación de los datos

    2.5. Evaluación del modelo

    2.6. Implementación del modelo

  3. Conclusiones

  4. Bibliografía

1. Introducción

Cada día se generan cantidades enormes de datos que reposan en los sistemas de información y bases de datos públicas o privadas. Es de interés para los analístas de datos obtener la mayor cantidad de información valiosa y confiable de estos datos, generando valor agregado a las entidades y así incidir en la toma de decisiones para mejorar los procesos internos y, por ende, los resultados económicos y sociales de la entidad. (FALTA UNA REFERENCIA)

Por esta razón, los estudiantes de la materia Analítica Predictiva del Posgrado de Analítica de la Universidad Nacional de Colombia tienen como objetivo identificar y dar solución a un problema utilizando las técnicas estadísticas y de ciencia de datos que consideren óptimas.

1.1. Motivación

La materia de Analítica Predictiva en el Posgrado de Analítica de la Universidad Nacional de Colombia enseña algunas técnicas estadísticas para el pronóstico y clasificación de datos, utilizando los conceptos de la estadística descriptiva y probabilística como cálculo de probabilidades, Teorema de Bayes, medidas de tendencia, funciones de distribuciones de probabilidad, pruebas de hipótesis, entre otros. Algunos de los modelos vistos en clase fueron:

  • K vecinos cercanos (k-nearest-neighbors)
  • Regresión lineal (univariada y multivariada)
  • Regresión Ridge y Lasso (Casos de multicolinealidad de la regresión lineal)
  • Regresión logística (logit)
  • Árboles de decisión y regresión (Decision Tree)
  • Bosques aleatorios (Random Forest)
  • K medias (K-means)
  • Agrupamiento jerárquico (cluster)
  • Máquinas de soporte vectorial (SVM)
  • Redes neuronales (Neural Network)
  • Validación cruzada (Cross validation)

El objetivo de este trabajo es entrenar un modelo predictivo que permita encontrar solución a un problema propuesto por los estudiantes. Este problema deberá contar con suficiente información para estimar el modelo y este no debe estar sobreentrenado.

Los entregables del trabajo son:

  1. Código de ejecución del modelo. (disponible aquí
  2. Reporte que contenga el entendimiento desarrollado en el trabajo, bibliografía de soporte y la metodología seguida debidamente justificada. (disponible aquí
  3. Aplicativo web que permita visualizar los datos y la predicción del modelo. (disponible aquí).
  4. Video promocional del aplicativo web, explicando su funcionalidad. (disponible aquí)

1.2. Metodología

Se propone utilizar la metodología CRISP-DM en la que se sigue un flujo de trabajo para la identificación del problema y la propuesta, evaluación e implementación de la solución. Los pasos de la metodología CRISP-DM son los siguientes:

  1. Identificación del problema del negocio.

  2. Identificación del problema de datos.

  3. Preparación y análisis de los datos.

  4. Modelación.

  5. Evaluación de los modelos y elección.

  6. Implementación.

Regresar

2. Desarrollo

2.1. Identificación del problema

La accidentalidad vial en las ciudades se ha ido posicionando año tras año como uno de los problemas que más costos sociales y económicos genera hasta llegar a denominarse como “pandemia”. Medellín no ha sido la excepción y en la actualidad buena parte de las políticas públicas se movilizan para mitigar este fenómeno. Se estima que anualmente los costos totales por accidentalidad solo para Medellín son cerca de $ 1,8 billones, así que este es un problema cuya minimización puede dejar muchas ganancias.

Una herramienta importante y base para la toma de decisiones es una estimación precisa que explique el problema y que permita predecir cuándo y dónde puede suceder determinado tipo de accidente.

Esta estimación es útil para diferentes actores. Los hacedores de política podrán determinar cuáles zonas son susceptibles de reestructuración de la malla vial, dónde deben enfocar los esfuerzos de capacitación o en cuáles lugares deben disponer de más servidores para la prevención y atención de los accidentes. Para el público en general le resultará de interés para tomar decisiones de movilidad, cuándo transitar y en qué; o en decisiones de vivienda, que sectores se deben evitar cuando se tienen hijos, por ejemplo.

En este trabajo se pretende responder a estas preguntas y brindarle a la ciudad la posibilidad de visibilizar la información de los accidentes vehiculares, sus riesgos asociados y con ello mitigarlos, a través de una única plataforma pública donde se realice un pronóstico del total de accidentes por tipo de accidente para el año 2019.

Regresar

2.2. Identificación de los datos

Para este trabajo se decidió utilizar la información de la accidentalidad vehicular en el municipio de Medellín para los años 2014 a 2018, disponibles al público en general en este enlace.

El conjunto de datos se compone de los accidentes de tránsito registrados por la Secretaría de Movilidad de la Alcaldía de Medellín, entre los años especificados. Se entiende por accidente de tránsito: “evento, generalmente involuntario, generado al menos por un un vehículo en movimiento, que causa daños a personas y bienes involucrados en él, e igualmente afecta la normal circulación de los vehículos que se movilizan por la vía o vías comprendidas en el lugar o dentro de la zona de influencia del hecho”. (Ley 769 de 2002 - Código Nacional de Tránsito)

La estructura de la tabla es la siguiente:

Campo Descripción Tipo Observación
OBJECTID Identificación del registro (fila) integer Sin
X Coordenada X (longitud) de la ubicación del accidente float Coordenadas en Magna Medellín. Ver nota.
Y Coordenada Y (latitud) de la ubicación del accidente float Coordenadas en Magna Medellín. Ver nota.
RADICADO Identificación única del accidente ante la Secretaría de Movilidad string Sin
HORA Hora aproximada de la ocurrencia del accidente datetime Sin
DIA_NOMBRE Nombre del día de la semana de la ocurrencia del accidente string Sin
PERIODO Año de la ocurrencia del accidente integer Sin
CLASE Tipo de accidente string Opciones entre: Atropello, caída del ocupante, choque, incendio, volcamiento y otro.
DIRECCION Dirección descriptiva de la ubicación de la ocurrencia del accidente string Sin
DIRECCION_ENC Dirección encasillada de la ubicación de la ocurrencia del accidente string Formato único de direcciones en el sistema de información de la Alcaldía de Medellín
CBML Identificación única del lote más cercano a la ubicación de la ocurrencia del accidente string Acrónimo de comuna, barrio, manzana, lote
TIPO_GEOCOD Tipo de ubicación según información catastral string Más información en el geocodificador de la Alcaldía disponible aquí
GRAVEDAD Gravedad del accidente string Opciones entre: Herido, muerto y solo daños
BARRIO Barrio de la ubicación de la ocurrencia del accidente string Sin
COMUNA Comuna de la ubicación de la ocurrencia del accidente string Sin
DISENO Tipo de entramado de la ubicación de la ocurrencia del accidente string Opciones entre: ciclo ruta, glorieta. intersección, lote o predio, paso a nivel, paso elevado, paso inferior, pontón, puente, tramo vía, túnel o vía peatonal
MES Número del mes de la ocurrencia del accidente integer Sin
DIA Día del mes de la ocurrencia del accidente integer Sin
FECHA Fecha de la ocurrencia del accidente string Formato ISO 8601
MES_NOMBRE Nombre del mes de la ocurrencia del accidente integer Columna vacía

Nota: las coordenadas Magna Medellín corresponden a una transformación de las coordenadas elípticas internacionales wgs84 a coordenadas planas propias establecidas por el Instituto Geográfico Agustín Codazzi (IGAC) en concordancia con el Subsecretaría de Catastro del municipio de Medellín.

Regresar

2.3. Descripción del conjunto de datos

Para el análisis de la información se utilizará el dialecto Tidyverse, los paquetes data.table, plotly, rmarkdown, shiny y leaflet para lectura y visualización de los datos y FALTA PAQUETES MODELADO.

2.3.1. Limpieza y resumen de los datos

# se instalan los paquetes necesarios

#install.packages("tidyverse")    # dialecto de ciencia de datos
#install.packages("data.table")   # manejo de tablas
#install.packages("ggplot2")      # manejo de graficas
#install.packages("plotly")       # graficas semi-dinamicas
#install.packages("rmarkdown")    # utilizar rmarkdown
#install.packages("shiny")        # tableros de control dinamicos
#install.packages("prettydoc")    # dar formato a rmarkdown
#install.packages("sf")           # manejo de archivos espaciales (.shp)
#install.packages("leaflet")      # mapas dinamicos en HTML
#install.packages("rpart")        # pendiente
#install.packages("rpart.plot")   # pendiente

# cargar librerias
library(data.table)   # manejo de tablas
library(purrr)        # optimizacion de bucles
library(dplyr)        # manejo de tablas
library(plotly)       # graficos en html
library(tidyr)        # limpieza de datos
library(stringr)      # limpieza de texto
library(lubridate)    # limpieza de fechas
library(sf)           # manejo de archivos espaciales

De manera inicial se leen los archivos.

Nota al ejecutador de código: para algunos sistemas operativos o versiones de paquetes la limpieza no funciona correctamente, por lo que se recomienda volver a cargar el archivo a partir aquí.

# lista archivos
lista <- list.files(pattern = "^Acc.*.csv", include.dirs = T, recursive = T)

# leer todos los archivos
lista_df <- map(lista, fread, sep = ",", encoding = "UTF-8", colClasses = "c")

# agregar archivos del 2014 a 2018
acc <- bind_rows(lista_df)

# ver cabecera del archivo
head(acc)

Se identifica que se deben hacer las siguientes correcciones en la tabla acc:

  • Organizar la columna FECHA en formato ISO 8601..

  • Debido a la naturaleza del trabajo, se eliminan los nulos de la columna.

CLASE y se unifican los tipos de accidente, limpiando tildes y convirtiendo en mayúscula.

  • De forma similar, se eliminan los nulos de la columna DISENO, se unifican los tipos de diseño, se limpian tildes y se convierte a mayúscula.

  • Se eliminan las tildes de los días de la semana en la columna DIA_NOMBRE.

  • Se crea la columna COMUNA_BARRIO a partir de la columna CBML con el objetivo de que sirva como clave foránea para la unión con el archivo espacial de barrios, disponible aquí.

# organizar fecha
acc$FECHA <- ymd(gsub(pattern = "T.*", replacement = "", acc$FECHA),
                  "%Y-%M-%D")[1:209426]

# eliminar datos nulos y corregir clase
acc <- acc[-which(acc$CLASE == ""),]
acc$CLASE <- iconv(acc$CLASE, from = "UTF-8", to = "ASCII//TRANSLIT")
acc$CLASE <- gsub("DE ", "", toupper(acc$CLASE))

# eliminar datos nulos y corregir disenio
acc <- acc[-which(acc$DISENO == ""),]
acc$DISENO <- iconv(acc$DISENO, from = "UTF-8", to = "ASCII//TRANSLIT")
acc$DISENO <- gsub("DE ", "", toupper(acc$DISENO))

# corregir tildes de DIA_NOMBRE
acc$DIA_NOMBRE <- iconv(acc$DIA_NOMBRE, from = "UTF-8", to = "ASCII//TRANSLIT")

# crear columna de comuna_barrio
acc <- mutate(acc, COMUNA_BARRIO = str_sub(CBML, 1, 4))

# visualizar nueva acc
head(acc)

Se procede a cargar el archivo espacial de barrios para identificar correctamente el barrio y la comuna de la ubicación del accidente. Luego, se realiza una nueva limpieza de la tabla acc: * Se limpian las tildes de la columna barrio y se convierte a mayúscula. * Se eliminan los registros duplicados generados por la unión. * Se eliminan algunas columnas no necesarias para el análisis. * Se renombran las columnas de NOMBRE_BAR y NOMBRE_COM por BARRIO y COMUNA respectivamente.

# cargar archivo shp de barrios de medellin
barrio <- read_sf("files/Limite_Barrio_Vereda_Catastral/Limite_Barrio_Vereda_Catastral.shp")

# unir columnas de nombre barrio y comuna
acc <- inner_join(acc, 
                  select(barrio, CODIGO, NOMBRE_COM, NOMBRE_BAR),
                  by = c("COMUNA_BARRIO" = "CODIGO"))
  
# limpiar nombre de barrios
acc$NOMBRE_BAR <- iconv(acc$NOMBRE_BAR, from = "UTF-8", to = "ASCII//TRANSLIT")
acc$NOMBRE_BAR <- toupper(acc$NOMBRE_BAR)

# eliminar posibles duplicados por errores de union
acc <- data.table:::unique.data.table(acc, by = "RADICADO")

# eliminar columnas
acc <- select(acc, -BARRIO, -COMUNA, -OBJECTID, -RADICADO, -DIRECCION_ENC,
              -DIRECCION, -HORA, -CBML, -TIPO_GEOCOD, -MES_NOMBRE, -geometry)

# renombrar
names(acc)[12:13] <- c("COMUNA","BARRIO")

# visualizar acc
head(acc)

Se realiza la lectura de la tabla de días especiales, se limpia y se realiza unión con la tabla de accidentes. * Se cambia las columnas tal que si es un día especial tenga la marcación Si, de lo contrario será No.

# lectura del archivo
festivos <- fread("files/festivos_y_especiales.csv", header = T)

# convertir a si o no
festivos[,names(festivos)[-1]] <- festivos %>%
                                  transmute_at(c(names(festivos)[-1]),
                                               funs(ifelse(. == "X",
                                                           "Si", 
                                                           ifelse(. == "",
                                                                  "No",
                                                                  .)
                                                           )
                                                    )
                                               )

# convetir a formato fecha
festivos$FECHA <- ymd(festivos$FECHA)[1:172]

# visualizar festivos
head(festivos)

Se realiza la unión de las tablas y se convierten los datos de los días especiales a No en caso de que no haya encontrado coincidencia en la unión.

# union de tablas
acc <- merge(x = acc, y = festivos, by = "FECHA", all.x = T)

# transformar variables
acc[,names(festivos)[-1]] <- acc %>%
                             transmute_at(c(names(festivos)[-1]),
                                         funs(ifelse(is.na(.),
                                                     "No",
                                                     .)
                                              )
                                         )

# visualizar acc
head(acc)

Se realiza la conversión a la codificación UTF-8 y se guarda el nuevo archivo.

# convertir a utf8
acc[,2:length(acc)] <- map(.x = acc[,2:length(acc)], .f = enc2utf8)

 # guardar archivo
fwrite(acc, "files/accidentalidad_georreferenciada_completa.csv", sep = ",")

# eliminar archivo y limpiar memoria
rm(acc)
gc(reset = T)
##           used (Mb) gc trigger  (Mb) max used (Mb)
## Ncells 1456730 77.8    2754562 147.2  1456730 77.8
## Vcells 8388610 64.1   31554028 240.8  8388610 64.1
Nueva lectura

Nota: para algunos sistemas operativos o versiones de paquetes la limpieza no funciona correctamente, por lo que se recomienda volver a cargar el archivo a partir de este punto y no ejecutar el código anterior.

# volver a cargar el archivo
acc <- fread("files/accidentalidad_georreferenciada_completa.csv",
             sep = ",",
             encoding = "UTF-8")

# organizar fecha
acc$FECHA <- ymd(acc$FECHA)

# visualizar
head(acc)

Como se observa, la estructura de la tabla resultante es la siguiente:

Campo Descripción Tipo Observación
FECHA Fecha de la ocurrencia del accidente datetime Formato ISO 8601
X Coordenada X (longitud) de la ubicación del accidente float Coordenadas en Magna Medellín. Ver nota.
Y Coordenada Y (latitud) de la ubicación del accidente float Coordenadas en Magna Medellín. Ver nota.
DIA_NOMBRE Nombre del día de la semana de la ocurrencia del accidente string Sin
PERIODO Año de la ocurrencia del accidente integer Sin
CLASE Tipo de accidente string Opciones entre: Atropello, caída del ocupante, choque, incendio, volcamiento y otro.
GRAVEDAD Gravedad del accidente string Opciones entre: Herido, muerto y solo daños
DISENO Tipo de entramado de la ubicación de la ocurrencia del accidente string Opciones entre: ciclo ruta, glorieta. intersección, lote o predio, paso a nivel, paso elevado, paso inferior, pontón, puente, tramo vía, túnel o vía peatonal
MES Número del mes de la ocurrencia del accidente integer Sin
DIA Día del mes de la ocurrencia del accidente integer Sin
COMUNA_BARRIO Identificador de la comuna y el barrio en el sistema de información de la Alcaldía string Sin
BARRIO Barrio de la ubicación de la ocurrencia del accidente string Sin
COMUNA Comuna de la ubicación de la ocurrencia del accidente string Sin
FESTIVO Indicador de si el día es festivo o no boolean Opciones: Si o No
MADRE Indicador de si el día es día de la madre o no boolean Opciones: Si o No
NAVIDAD Indicador de si el día pertenece a las festividades de navidad o no boolean Opciones: Si o No
BRUJITOS Indicador de si el día es el 31 de octubre o no boolean Opciones: Si o No
SEMSANTA Indicador de si el día pertenece a la Semana Santa o no boolean Opciones: Si o No
ESCOLAR Indicador de si el día pertenece a la época de vacaciones escolares o no boolean Opciones: Si o No

2.3.2. Análisis

Primero realizaremos un análisis descriptivo univariado de las variables por el número de accidentes registrados

Accidentes por comuna
acc_comuna <- acc %>% 
              group_by(COMUNA) %>% 
              summarize(total_registros = n())
ggplot(data=acc_comuna, aes(x=COMUNA, y=total_registros)) + 
    geom_bar(stat="identity", position="dodge", fill = "blue3", color = "grey48", alpha = .8)+
    xlab("Comuna")+ # eje x
    ylab("Total registros")+ # eje y
    ggtitle("Número de accidentes por comuna")+ #título del gráfico
    coord_flip()

El mayor número de accidentes ocurre en La candelaria, seguido por Laureles y Castilla.

Número de accidentes por mes
acc_mes <- acc %>% 
              group_by(MES) %>% 
              summarize(total_registros = n())
p1 <- ggplot(data=acc_mes, aes(x=MES, y=total_registros)) + 
    geom_bar(stat="identity", position="dodge", fill = "blue3", color = "grey48", alpha = 
    .8)+
    xlab("Mes")+ # eje x
    ylab("Total registros")+ # eje y
    ggtitle("Número de accidentes por mes") #título del gráfico

p1

En el mes donde mayor cantidad de accidentes ocurre es en Agosto.

Accidentalidad por día
acc_nombredia <- acc %>% 
              group_by(DIA_NOMBRE) %>% 
              summarize(total_registros = n())
acc_nombredia$DIA_NOMBRE<-ordered(acc_nombredia$DIA_NOMBRE,levels=c( "LUNES", "MARTES", "MIERCOLES", "JUEVES", "VIERNES", "SABADO","DOMINGO"))

p2 <- ggplot(data=acc_nombredia, aes(x=DIA_NOMBRE, y=total_registros)) + 
    geom_bar(stat="identity", position="dodge", fill = "blue3", color = "grey48", alpha = 
    .8)+
    xlab("Días")+ # eje x
    ylab("Total registros")+ # eje y
    ggtitle("Número de accidentes por días de la semana") #título del gráfico

p2

Los viernes son los días que mayor accidentalidad presenta y el día con menos accidentalidad es el domingo.

Accidentalidad por año
acc_ano <- acc %>% 
              group_by(PERIODO) %>% 
              summarize(total_registros = n())
p3 <- ggplot(data=acc_ano, aes(x=PERIODO, y=total_registros)) + 
    geom_bar(stat="identity", position="dodge", fill = "blue3", color = "grey48", alpha = 
    .8)+
    xlab("Año")+ # eje x
    ylab("Total registros")+ # eje y
    ggtitle("Número de accidentes por año") #título del gráfico

p3

El año 2016 fue el año con mayor accidentalidad mientras que 2018 tuvo menos accidentes.

Accidentalidad por tipo de accidente
acc_clase <- acc %>% 
              group_by(CLASE) %>% 
              summarize(total_registros = n())
p4 <- ggplot(data=acc_clase, aes(x=CLASE, y=total_registros)) + 
    geom_bar(stat="identity", position="dodge", fill = "blue3", color = "grey48", alpha = 
    .8)+
    xlab("Tipo de accidente")+ # eje x
    ylab("Total registros")+ # eje y
    ggtitle("Número de accidentes por tipo de accidente") #título del gráfico

p4

El menor número de accidentes ocurre por incendio mientras que los choques son los que generan mayores accidentes de tránsito.

Accidentes por gravedad
acc_gravedad <- acc %>% 
              group_by(GRAVEDAD) %>% 
              summarize(total_registros = n())
ggplot(data=acc_gravedad, aes(x=GRAVEDAD, y=total_registros)) + 
    geom_bar(stat="identity", position="dodge", fill = "blue3", color = "grey48", alpha = 
    .8)+
    xlab("Gravedad del accidente")+ # eje x
    ylab("Total registros")+ # eje y
    ggtitle("Número de accidentes por gravedad del accidente") #título del gráfico

Desde el 2014 hasta el 2018 se tuvieron un número mayor de heridos que de daños.

Accidentes por diseño
acc_diseno <- acc %>% 
              group_by(DISENO) %>% 
              summarize(total_registros = n())
ggplot(data=acc_diseno, aes(x=DISENO, y=total_registros)) + 
    geom_bar(stat="identity", position="dodge", fill = "blue3", color = "grey48", alpha = 
    .8)+
    xlab("Diseño de la vía")+ # eje x
    ylab("Total registros")+ # eje y
    ggtitle("Número de accidentes por tipo de vía")+ #título del gráfico
    coord_flip()

La mayor cantidad de accidentes se presentan en los tramos de vía seguidos por las intersecciones.

Ahora analizaremos las variables agrupadas por la clase de accidente.
Agrupar Clase-Gravedad
acc_group_clase<- acc %>% group_by(CLASE, GRAVEDAD) %>% summarize(conteo = n())

ggplot(data=acc_group_clase, aes(x=CLASE, y=conteo, fill=GRAVEDAD)) + 
    geom_bar(stat="identity", position="dodge")+
    coord_flip()

De acuerdo al tipo de accidente, vemos que los choques generan una mayor cantidad de daños y la mayor cantidad de heridos.

Agrupar clase-Mes
acc_group_mes<- acc %>% group_by(MES,CLASE) %>% summarize(conteo = n()) 
ggplot(data=acc_group_mes, aes(x=CLASE, y=conteo, fill=MES)) + 
    geom_bar(stat="identity", position="dodge")

La mayor cantidad de choques se presenta en agosto.

Agrupar Clase-Periodo
acc_group_year<- acc %>% group_by(CLASE, PERIODO) %>% summarize(conteo = n()) 
ggplot(data=acc_group_year, aes(x=CLASE, y=conteo, fill=as.factor(PERIODO))) + 
    geom_bar(stat="identity", position="dodge")+
    scale_fill_manual(values=c("#d0d1e6", "#bdc9e1","#74a9cf","#2b8cbe","#045a8d"))

Gráfica Clase-Periodo
acc_group_dia<- acc %>% group_by(CLASE, DIA_NOMBRE) %>% summarize(conteo = n()) 

ggplot(data=acc_group_dia, aes(x=CLASE, y=conteo, fill=DIA_NOMBRE)) + 
    geom_bar(stat="identity", position="dodge")+
    scale_fill_manual(values=c("#67001f","#b2182b","#d6604d","#f4a582","#fddbc7","#d1e5f0", "#92c5de"))+
  coord_flip()

Gráfica Clase-festivo
acc_group_festivo<- acc %>% group_by(CLASE, FESTIVO) %>% summarize(conteo = n()) 

ggplot(data=acc_group_festivo, aes(x=CLASE, y=conteo, fill=FESTIVO)) + 
    geom_bar(stat="identity", position="dodge")

Registro de accidentalidad por día
acc_fecha <- acc %>% 
              group_by(FECHA) %>% 
              summarize(total_registros = n())

plot_ly (data=subset(acc_fecha,subset = (FECHA<="2018-12-31")),
         x = ~FECHA,
         y = ~total_registros,
         type = "scatter" ,mode = "lines",
         line=list(width=1,color='rgb(205, 12, 24)'))%>%
         layout(title='Registros de accidentalidad',
         xaxis=list(title="Día"),
         yaxis=list(title="Total registros"))
Accidentalidad por año
acc_fecha$year<-format(acc_fecha$FECHA,"%Y")
plot_ly (data=subset(acc_fecha,subset = (FECHA<="2018-12-31")),
         x = ~FECHA,
         y = ~total_registros,
         type = "scatter" ,mode = "lines",
         split = ~year,
         line=list(width=1))%>%
  layout(title='Registros de accidentalidad',
         xaxis=list(title="Día"),
         yaxis=list(title="Total registros"))
Utilicemos la función aggregate para obtener el promedio diario para cada año de registros de accidentes:
aggregate(total_registros~year,data=acc_fecha,FUN=mean)
Ahora obtengamos el promedio diario para cada mes y cada año: OJO CON ESTO
acc_fecha$Fecha<-as.Date(acc_fecha$FECHA,"%d/%m/%Y")
acc_fecha$mes<-format(acc_fecha$Fecha,"%m")
with(acc_fecha, month.abb[mes])
##    [1] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##   [24] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##   [47] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##   [70] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##   [93] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##  [116] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##  [139] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##  [162] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##  [185] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##  [208] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##  [231] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##  [254] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##  [277] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##  [300] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##  [323] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##  [346] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##  [369] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##  [392] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##  [415] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##  [438] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##  [461] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##  [484] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##  [507] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##  [530] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##  [553] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##  [576] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##  [599] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##  [622] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##  [645] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##  [668] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##  [691] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##  [714] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##  [737] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##  [760] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##  [783] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##  [806] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##  [829] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##  [852] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##  [875] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##  [898] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##  [921] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##  [944] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##  [967] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##  [990] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
## [1013] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
## [1036] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
## [1059] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
## [1082] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
## [1105] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
## [1128] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
## [1151] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
## [1174] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
## [1197] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
## [1220] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
## [1243] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
## [1266] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
## [1289] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
## [1312] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
## [1335] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
## [1358] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
## [1381] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
## [1404] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
## [1427] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
## [1450] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
## [1473] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
## [1496] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
## [1519] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
## [1542] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
## [1565] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
## [1588] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
## [1611] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
## [1634] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
## [1657] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
## [1680] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
## [1703] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
## [1726] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
## [1749] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
## [1772] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
## [1795] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
## [1818] NA NA NA NA NA NA NA NA NA
acc_fecha$mes<-strftime(acc_fecha$Fecha, format = "%B")
acc_fecha$mes<-ordered(acc_fecha$mes,levels=c( "enero", "febrero", "marzo", 
"abril", "mayo", "junio","julio", "agosto", "septiembre", "octubre", "noviembre", "diciembre"))
aggregate(total_registros~year*mes,data=acc_fecha,FUN=mean)%>%
  plot_ly(x = ~mes,
         y = ~total_registros,
         type = "scatter" ,mode = "lines",
         split = ~year,
         line=list(width=1))%>%
  layout(title='Promedio diario mensual de accidentes registrados',
         xaxis=list(title="Día"),
         yaxis=list(title="Total registros"))
Ahora utilicemos el diagrama de caja y bigotes para explorar relaciones:
plot_ly (data=subset(acc_fecha,subset = (Fecha<="2018-12-31")),
         x = ~year,
         y = ~total_registros,
         type = "box")%>%
  layout(title='Registros de accidentes',
         xaxis=list(title="Año"),
         yaxis=list(title="Total registros"))

Ahora, hacemos algo similar a lo anterior para los meses del año y los días de la semana:

Veamos el diagrama de caja y bigotes para cada mes:
acc_fecha$diames<-format(acc_fecha$Fecha,"%d")
plot_ly (data=subset(acc_fecha,subset = (Fecha<="2018-12-31")),
         x = ~mes,
         y = ~total_registros,
         type = "box")%>%
  layout(title='Registros de accidentes',
         xaxis=list(title="Mes"),
         yaxis=list(title="Total registros"))
Para cada día de la semana:
acc_fecha$dia_semana<-weekdays(acc_fecha$Fecha)
acc_fecha$dia_semana<-ordered(acc_fecha$dia_semana,levels=c( "lunes", "martes", "miércoles", "jueves", "viernes", "sábado","domingo"))
plot_ly (data=subset(acc_fecha,subset = (Fecha<="2018-12-31")),
         x = ~dia_semana,
         y = ~total_registros,
         type = "box")%>%
  layout(title='Registros de accidentes',
         xaxis=list(title="Mes"),
         yaxis=list(title="Total registros"))

Regresar

2.3.3. Datos atípicos o nulos

El manejo de datos nulos se dio en la sección 2.3.1. donde se tomaron las siguientes decisiones:

  • Si CLASE era nulo, se eliminaba por la naturaleza del objetivo.
  • Si DISENO era nulo, se eliminaba por la naturaleza del objetivo.
  • Si COMUNA_BARRIO era nulo o no estaba en la tabla de barrios, se eliminaba ya que posiblemente corresponda a un dato difícil de medir.

Después de realizar el análisis, se concluye que ningún dato atípico será eliminado ya que corresponden a los datos de las tablas originales, a los cuales se les aplicaron transformaciones mínimas.

Regresar

2.4. Modelación de los datos

Se escogen tres agrupamientos para verificar el modelo.

acc_agrupado_0 <- acc%>%group_by(FECHA,CLASE,DISENO,DIA_NOMBRE,DIA,PERIODO,FESTIVO,MADRE,NAVIDAD,BRUJITOS,SEMSANTA,ESCOLAR)%>%summarise(ACCIDENTES=n())%>%arrange(FECHA)
acc_agrupado_0$DIA <- as.integer(acc_agrupado_0$DIA)
acc_agrupado_0$PERIODO <- as.integer(acc_agrupado_0$PERIODO)


acc_agrupado_1<-acc%>%group_by(FECHA,CLASE,DIA_NOMBRE,DIA,PERIODO,FESTIVO,MADRE,NAVIDAD,BRUJITOS,SEMSANTA,ESCOLAR)%>%summarise(ACCIDENTES=n())%>%arrange(FECHA)
acc_agrupado_1$DIA <- as.integer(acc_agrupado_1$DIA)
acc_agrupado_1$PERIODO <- as.integer(acc_agrupado_1$PERIODO)

acc_agrupado_2 <-acc%>%group_by(FECHA,DIA_NOMBRE,PERIODO,CLASE,MES,DIA,COMUNA,FESTIVO,MADRE,NAVIDAD,BRUJITOS,SEMSANTA,ESCOLAR)%>%summarise(ACCIDENTES=n())%>%arrange(FECHA)
acc_agrupado_2$DIA <- as.integer(acc_agrupado_2$DIA)
acc_agrupado_2$PERIODO <- as.integer(acc_agrupado_2$PERIODO)
Elección del modelo de regresión
Modelo grupo 0
#acc_year$PERIODO <- as.numeric(acc_year$PERIODO)
modelo_lm_0<-lm(ACCIDENTES~FECHA+CLASE+DISENO+DIA_NOMBRE+PERIODO+FESTIVO+MADRE+NAVIDAD+BRUJITOS+SEMSANTA+ESCOLAR,data=acc_agrupado_0, subset = (FECHA<="2017-12-31"))
summary(modelo_lm_0)
## 
## Call:
## lm(formula = ACCIDENTES ~ FECHA + CLASE + DISENO + DIA_NOMBRE + 
##     PERIODO + FESTIVO + MADRE + NAVIDAD + BRUJITOS + SEMSANTA + 
##     ESCOLAR, data = acc_agrupado_0, subset = (FECHA <= "2017-12-31"))
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -23.300  -6.657  -2.583   4.472  63.013 
## 
## Coefficients:
##                       Estimate Std. Error t value Pr(>|t|)    
## (Intercept)          1.040e+03  5.886e+02   1.768 0.077120 .  
## FECHA                2.176e-03  7.966e-04   2.732 0.006304 ** 
## CLASECAIDA OCUPANTE -3.321e-01  2.841e-01  -1.169 0.242387    
## CLASECHOQUE          2.014e+01  2.508e-01  80.296  < 2e-16 ***
## CLASEINCENDIO       -9.749e+00  2.607e+00  -3.739 0.000185 ***
## CLASEOTRO            1.147e+00  2.814e-01   4.077 4.57e-05 ***
## CLASEVOLCAMIENTO    -5.297e+00  3.086e-01 -17.165  < 2e-16 ***
## DISENOGLORIETA      -4.280e+00  6.008e-01  -7.125 1.08e-12 ***
## DISENOINTERSECCION   9.001e+00  5.622e-01  16.011  < 2e-16 ***
## DISENOLOTE O PREDIO  6.244e+00  5.647e-01  11.057  < 2e-16 ***
## DISENOPASO A NIVEL  -5.699e+00  1.701e+00  -3.351 0.000808 ***
## DISENOPASO ELEVADO  -5.339e+00  7.015e-01  -7.611 2.86e-14 ***
## DISENOPASO INFERIOR -3.482e+00  8.257e-01  -4.217 2.48e-05 ***
## DISENOPONTON        -3.752e+00  2.581e+00  -1.454 0.146002    
## DISENOPUENTE        -5.320e+00  7.470e-01  -7.121 1.11e-12 ***
## DISENOTRAMO VIA      2.445e+01  5.506e-01  44.412  < 2e-16 ***
## DISENOTUNEL         -2.347e+00  2.653e+00  -0.885 0.376368    
## DISENOVIA PEATONAL   9.371e-01  1.756e+00   0.534 0.593660    
## DIA_NOMBREJUEVES     3.904e+00  3.139e-01  12.436  < 2e-16 ***
## DIA_NOMBRELUNES      3.618e+00  3.202e-01  11.299  < 2e-16 ***
## DIA_NOMBREMARTES     4.262e+00  3.143e-01  13.562  < 2e-16 ***
## DIA_NOMBREMIERCOLES  3.865e+00  3.152e-01  12.261  < 2e-16 ***
## DIA_NOMBRESABADO     3.258e+00  3.172e-01  10.271  < 2e-16 ***
## DIA_NOMBREVIERNES    4.386e+00  3.127e-01  14.027  < 2e-16 ***
## PERIODO             -5.409e-01  2.985e-01  -1.812 0.069971 .  
## FESTIVOSi           -2.828e+00  5.185e-01  -5.454 4.98e-08 ***
## MADRESi              1.414e+00  1.650e+00   0.857 0.391666    
## NAVIDADSi           -2.479e+00  8.407e-01  -2.949 0.003193 ** 
## BRUJITOSSi           5.316e-01  1.522e+00   0.349 0.726828    
## SEMSANTASi          -2.466e+00  6.244e-01  -3.949 7.87e-05 ***
## ESCOLARSi           -3.418e-01  6.907e-01  -0.495 0.620711    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 10.71 on 17203 degrees of freedom
## Multiple R-squared:  0.5463, Adjusted R-squared:  0.5455 
## F-statistic: 690.5 on 30 and 17203 DF,  p-value: < 2.2e-16
Modelo grupo 1
#acc_year$PERIODO <- as.numeric(acc_year$PERIODO)
modelo_lm_1<-lm(ACCIDENTES~FECHA+CLASE+DIA_NOMBRE+DIA+PERIODO+FESTIVO+MADRE+NAVIDAD+BRUJITOS+SEMSANTA+ESCOLAR,data=acc_agrupado_1, subset = (FECHA<="2017-12-31"))
summary(modelo_lm_1)
## 
## Call:
## lm(formula = ACCIDENTES ~ FECHA + CLASE + DIA_NOMBRE + DIA + 
##     PERIODO + FESTIVO + MADRE + NAVIDAD + BRUJITOS + SEMSANTA + 
##     ESCOLAR, data = acc_agrupado_1, subset = (FECHA <= "2017-12-31"))
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -60.136  -3.780  -0.428   4.098  52.536 
## 
## Coefficients:
##                       Estimate Std. Error t value Pr(>|t|)    
## (Intercept)          2.393e+03  7.909e+02   3.026 0.002485 ** 
## FECHA                3.889e-03  1.064e-03   3.654 0.000260 ***
## CLASECAIDA OCUPANTE -1.167e+00  3.450e-01  -3.382 0.000722 ***
## CLASECHOQUE          6.563e+01  3.450e-01 190.246  < 2e-16 ***
## CLASEINCENDIO       -1.028e+01  2.277e+00  -4.516 6.41e-06 ***
## CLASEOTRO            1.156e+00  3.450e-01   3.352 0.000806 ***
## CLASEVOLCAMIENTO    -7.471e+00  3.496e-01 -21.370  < 2e-16 ***
## DIA_NOMBREJUEVES     9.262e+00  4.130e-01  22.428  < 2e-16 ***
## DIA_NOMBRELUNES      8.485e+00  4.202e-01  20.191  < 2e-16 ***
## DIA_NOMBREMARTES     9.893e+00  4.144e-01  23.870  < 2e-16 ***
## DIA_NOMBREMIERCOLES  9.359e+00  4.127e-01  22.676  < 2e-16 ***
## DIA_NOMBRESABADO     7.739e+00  4.124e-01  18.768  < 2e-16 ***
## DIA_NOMBREVIERNES    1.038e+01  4.132e-01  25.117  < 2e-16 ***
## DIA                 -1.367e-02  1.266e-02  -1.080 0.279962    
## PERIODO             -1.218e+00  4.010e-01  -3.037 0.002396 ** 
## FESTIVOSi           -6.729e+00  6.740e-01  -9.984  < 2e-16 ***
## MADRESi              4.043e+00  2.107e+00   1.919 0.055026 .  
## NAVIDADSi           -7.228e+00  1.069e+00  -6.765 1.44e-11 ***
## BRUJITOSSi           1.673e+00  2.102e+00   0.796 0.426076    
## SEMSANTASi          -6.326e+00  8.072e-01  -7.837 5.28e-15 ***
## ESCOLARSi           -1.805e+00  9.617e-01  -1.877 0.060561 .  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 9.323 on 7225 degrees of freedom
## Multiple R-squared:  0.897,  Adjusted R-squared:  0.8967 
## F-statistic:  3145 on 20 and 7225 DF,  p-value: < 2.2e-16

Al verificar los valores P, se opta por retirar la variable BRUJITOS.

#acc_year$PERIODO <- as.numeric(acc_year$PERIODO)
modelo_lm_1<-lm(ACCIDENTES~FECHA+CLASE+DIA_NOMBRE+DIA+PERIODO+FESTIVO+MADRE+NAVIDAD+SEMSANTA+ESCOLAR,data=acc_agrupado_1, subset = (FECHA<="2017-12-31"))
summary(modelo_lm_1)
## 
## Call:
## lm(formula = ACCIDENTES ~ FECHA + CLASE + DIA_NOMBRE + DIA + 
##     PERIODO + FESTIVO + MADRE + NAVIDAD + SEMSANTA + ESCOLAR, 
##     data = acc_agrupado_1, subset = (FECHA <= "2017-12-31"))
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -60.147  -3.778  -0.431   4.090  52.536 
## 
## Coefficients:
##                       Estimate Std. Error t value Pr(>|t|)    
## (Intercept)          2.426e+03  7.898e+02   3.071 0.002141 ** 
## FECHA                3.934e-03  1.063e-03   3.701 0.000216 ***
## CLASECAIDA OCUPANTE -1.167e+00  3.450e-01  -3.382 0.000722 ***
## CLASECHOQUE          6.563e+01  3.450e-01 190.251  < 2e-16 ***
## CLASEINCENDIO       -1.029e+01  2.277e+00  -4.517 6.36e-06 ***
## CLASEOTRO            1.156e+00  3.450e-01   3.352 0.000806 ***
## CLASEVOLCAMIENTO    -7.471e+00  3.496e-01 -21.370  < 2e-16 ***
## DIA_NOMBREJUEVES     9.262e+00  4.129e-01  22.429  < 2e-16 ***
## DIA_NOMBRELUNES      8.493e+00  4.201e-01  20.218  < 2e-16 ***
## DIA_NOMBREMARTES     9.901e+00  4.143e-01  23.897  < 2e-16 ***
## DIA_NOMBREMIERCOLES  9.359e+00  4.127e-01  22.677  < 2e-16 ***
## DIA_NOMBRESABADO     7.747e+00  4.122e-01  18.794  < 2e-16 ***
## DIA_NOMBREVIERNES    1.039e+01  4.130e-01  25.146  < 2e-16 ***
## DIA                 -1.282e-02  1.261e-02  -1.016 0.309497    
## PERIODO             -1.234e+00  4.004e-01  -3.082 0.002062 ** 
## FESTIVOSi           -6.732e+00  6.740e-01  -9.988  < 2e-16 ***
## MADRESi              4.050e+00  2.107e+00   1.922 0.054634 .  
## NAVIDADSi           -7.239e+00  1.068e+00  -6.775 1.34e-11 ***
## SEMSANTASi          -6.327e+00  8.072e-01  -7.839 5.20e-15 ***
## ESCOLARSi           -1.809e+00  9.617e-01  -1.882 0.059933 .  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 9.322 on 7226 degrees of freedom
## Multiple R-squared:  0.897,  Adjusted R-squared:  0.8967 
## F-statistic:  3310 on 19 and 7226 DF,  p-value: < 2.2e-16

No se observa nigun cambio en el R cuadrado ajustado. se opta por quitar DIA.

#acc_year$PERIODO <- as.numeric(acc_year$PERIODO)
modelo_lm_1<-lm(ACCIDENTES~FECHA+CLASE+DIA_NOMBRE+PERIODO+FESTIVO+MADRE+NAVIDAD+SEMSANTA+ESCOLAR,data=acc_agrupado_1, subset = (FECHA<="2017-12-31"))
summary(modelo_lm_1)
## 
## Call:
## lm(formula = ACCIDENTES ~ FECHA + CLASE + DIA_NOMBRE + PERIODO + 
##     FESTIVO + MADRE + NAVIDAD + SEMSANTA + ESCOLAR, data = acc_agrupado_1, 
##     subset = (FECHA <= "2017-12-31"))
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -60.261  -3.762  -0.431   4.105  52.692 
## 
## Coefficients:
##                       Estimate Std. Error t value Pr(>|t|)    
## (Intercept)          2.347e+03  7.860e+02   2.986 0.002838 ** 
## FECHA                3.825e-03  1.057e-03   3.617 0.000300 ***
## CLASECAIDA OCUPANTE -1.167e+00  3.450e-01  -3.382 0.000722 ***
## CLASECHOQUE          6.563e+01  3.450e-01 190.250  < 2e-16 ***
## CLASEINCENDIO       -1.028e+01  2.277e+00  -4.515 6.43e-06 ***
## CLASEOTRO            1.156e+00  3.450e-01   3.352 0.000807 ***
## CLASEVOLCAMIENTO    -7.471e+00  3.496e-01 -21.371  < 2e-16 ***
## DIA_NOMBREJUEVES     9.260e+00  4.129e-01  22.424  < 2e-16 ***
## DIA_NOMBRELUNES      8.485e+00  4.200e-01  20.203  < 2e-16 ***
## DIA_NOMBREMARTES     9.900e+00  4.143e-01  23.894  < 2e-16 ***
## DIA_NOMBREMIERCOLES  9.359e+00  4.127e-01  22.677  < 2e-16 ***
## DIA_NOMBRESABADO     7.749e+00  4.122e-01  18.798  < 2e-16 ***
## DIA_NOMBREVIERNES    1.038e+01  4.130e-01  25.143  < 2e-16 ***
## PERIODO             -1.194e+00  3.985e-01  -2.997 0.002735 ** 
## FESTIVOSi           -6.684e+00  6.723e-01  -9.941  < 2e-16 ***
## MADRESi              4.108e+00  2.106e+00   1.951 0.051131 .  
## NAVIDADSi           -7.283e+00  1.068e+00  -6.822 9.68e-12 ***
## SEMSANTASi          -6.341e+00  8.071e-01  -7.857 4.49e-15 ***
## ESCOLARSi           -1.715e+00  9.572e-01  -1.792 0.073162 .  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 9.322 on 7227 degrees of freedom
## Multiple R-squared:  0.8969, Adjusted R-squared:  0.8967 
## F-statistic:  3494 on 18 and 7227 DF,  p-value: < 2.2e-16

No se observa nigun cambio en el R cuadrado ajustado. se opta por quitar MADRE.

#acc_year$PERIODO <- as.numeric(acc_year$PERIODO)
modelo_lm_1<-lm(ACCIDENTES~FECHA+CLASE+DIA_NOMBRE+PERIODO+FESTIVO+NAVIDAD+SEMSANTA+ESCOLAR,data=acc_agrupado_1, subset = (FECHA<="2017-12-31"))
summary(modelo_lm_1)
## 
## Call:
## lm(formula = ACCIDENTES ~ FECHA + CLASE + DIA_NOMBRE + PERIODO + 
##     FESTIVO + NAVIDAD + SEMSANTA + ESCOLAR, data = acc_agrupado_1, 
##     subset = (FECHA <= "2017-12-31"))
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -60.249  -3.763  -0.433   4.122  52.693 
## 
## Coefficients:
##                       Estimate Std. Error t value Pr(>|t|)    
## (Intercept)          2.308e+03  7.859e+02   2.937 0.003328 ** 
## FECHA                3.770e-03  1.057e-03   3.566 0.000365 ***
## CLASECAIDA OCUPANTE -1.167e+00  3.451e-01  -3.382 0.000725 ***
## CLASECHOQUE          6.563e+01  3.450e-01 190.213  < 2e-16 ***
## CLASEINCENDIO       -1.029e+01  2.278e+00  -4.518 6.34e-06 ***
## CLASEOTRO            1.156e+00  3.450e-01   3.351 0.000809 ***
## CLASEVOLCAMIENTO    -7.470e+00  3.496e-01 -21.364  < 2e-16 ***
## DIA_NOMBREJUEVES     9.180e+00  4.110e-01  22.337  < 2e-16 ***
## DIA_NOMBRELUNES      8.406e+00  4.181e-01  20.105  < 2e-16 ***
## DIA_NOMBREMARTES     9.819e+00  4.123e-01  23.814  < 2e-16 ***
## DIA_NOMBREMIERCOLES  9.279e+00  4.108e-01  22.590  < 2e-16 ***
## DIA_NOMBRESABADO     7.669e+00  4.103e-01  18.693  < 2e-16 ***
## DIA_NOMBREVIERNES    1.030e+01  4.110e-01  25.069  < 2e-16 ***
## PERIODO             -1.175e+00  3.985e-01  -2.948 0.003212 ** 
## FESTIVOSi           -6.691e+00  6.724e-01  -9.951  < 2e-16 ***
## NAVIDADSi           -7.299e+00  1.068e+00  -6.836 8.82e-12 ***
## SEMSANTASi          -6.358e+00  8.072e-01  -7.877 3.83e-15 ***
## ESCOLARSi           -1.711e+00  9.574e-01  -1.787 0.074014 .  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 9.324 on 7228 degrees of freedom
## Multiple R-squared:  0.8969, Adjusted R-squared:  0.8966 
## F-statistic:  3698 on 17 and 7228 DF,  p-value: < 2.2e-16

No se observa nigun cambio en el R cuadrado ajustado. se opta por quitar ESCOLAR.

modelo_lm_1<-lm(ACCIDENTES~FECHA+CLASE+DIA_NOMBRE+PERIODO+FESTIVO+NAVIDAD+SEMSANTA,data=acc_agrupado_1, subset = (FECHA<="2017-12-31"))
summary(modelo_lm_1)
## 
## Call:
## lm(formula = ACCIDENTES ~ FECHA + CLASE + DIA_NOMBRE + PERIODO + 
##     FESTIVO + NAVIDAD + SEMSANTA, data = acc_agrupado_1, subset = (FECHA <= 
##     "2017-12-31"))
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -60.242  -3.769  -0.465   4.134  52.735 
## 
## Coefficients:
##                       Estimate Std. Error t value Pr(>|t|)    
## (Intercept)          2.158e+03  7.815e+02   2.761 0.005778 ** 
## FECHA                3.561e-03  1.051e-03   3.389 0.000706 ***
## CLASECAIDA OCUPANTE -1.167e+00  3.452e-01  -3.381 0.000726 ***
## CLASECHOQUE          6.563e+01  3.451e-01 190.185  < 2e-16 ***
## CLASEINCENDIO       -1.027e+01  2.278e+00  -4.507 6.67e-06 ***
## CLASEOTRO            1.156e+00  3.451e-01   3.351 0.000810 ***
## CLASEVOLCAMIENTO    -7.468e+00  3.497e-01 -21.356  < 2e-16 ***
## DIA_NOMBREJUEVES     9.150e+00  4.107e-01  22.279  < 2e-16 ***
## DIA_NOMBRELUNES      8.370e+00  4.177e-01  20.039  < 2e-16 ***
## DIA_NOMBREMARTES     9.787e+00  4.120e-01  23.755  < 2e-16 ***
## DIA_NOMBREMIERCOLES  9.247e+00  4.104e-01  22.530  < 2e-16 ***
## DIA_NOMBRESABADO     7.670e+00  4.103e-01  18.693  < 2e-16 ***
## DIA_NOMBREVIERNES    1.027e+01  4.107e-01  25.010  < 2e-16 ***
## PERIODO             -1.098e+00  3.962e-01  -2.772 0.005588 ** 
## FESTIVOSi           -6.660e+00  6.723e-01  -9.906  < 2e-16 ***
## NAVIDADSi           -7.259e+00  1.068e+00  -6.799 1.13e-11 ***
## SEMSANTASi          -6.352e+00  8.073e-01  -7.869 4.11e-15 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 9.326 on 7229 degrees of freedom
## Multiple R-squared:  0.8968, Adjusted R-squared:  0.8966 
## F-statistic:  3928 on 16 and 7229 DF,  p-value: < 2.2e-16

Dado que al quitar la variable anterior el R cuadrado ajustado bajo 0.0001, por lo cual se opta por dejar el modelo con la variable ESCOLAR.

#acc_year$PERIODO <- as.numeric(acc_year$PERIODO)
modelo_lm_1<-lm(ACCIDENTES~FECHA+CLASE+DIA_NOMBRE+PERIODO+FESTIVO+NAVIDAD+SEMSANTA+ESCOLAR,data=acc_agrupado_1, subset = (FECHA<="2017-12-31"))
summary(modelo_lm_1)
## 
## Call:
## lm(formula = ACCIDENTES ~ FECHA + CLASE + DIA_NOMBRE + PERIODO + 
##     FESTIVO + NAVIDAD + SEMSANTA + ESCOLAR, data = acc_agrupado_1, 
##     subset = (FECHA <= "2017-12-31"))
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -60.249  -3.763  -0.433   4.122  52.693 
## 
## Coefficients:
##                       Estimate Std. Error t value Pr(>|t|)    
## (Intercept)          2.308e+03  7.859e+02   2.937 0.003328 ** 
## FECHA                3.770e-03  1.057e-03   3.566 0.000365 ***
## CLASECAIDA OCUPANTE -1.167e+00  3.451e-01  -3.382 0.000725 ***
## CLASECHOQUE          6.563e+01  3.450e-01 190.213  < 2e-16 ***
## CLASEINCENDIO       -1.029e+01  2.278e+00  -4.518 6.34e-06 ***
## CLASEOTRO            1.156e+00  3.450e-01   3.351 0.000809 ***
## CLASEVOLCAMIENTO    -7.470e+00  3.496e-01 -21.364  < 2e-16 ***
## DIA_NOMBREJUEVES     9.180e+00  4.110e-01  22.337  < 2e-16 ***
## DIA_NOMBRELUNES      8.406e+00  4.181e-01  20.105  < 2e-16 ***
## DIA_NOMBREMARTES     9.819e+00  4.123e-01  23.814  < 2e-16 ***
## DIA_NOMBREMIERCOLES  9.279e+00  4.108e-01  22.590  < 2e-16 ***
## DIA_NOMBRESABADO     7.669e+00  4.103e-01  18.693  < 2e-16 ***
## DIA_NOMBREVIERNES    1.030e+01  4.110e-01  25.069  < 2e-16 ***
## PERIODO             -1.175e+00  3.985e-01  -2.948 0.003212 ** 
## FESTIVOSi           -6.691e+00  6.724e-01  -9.951  < 2e-16 ***
## NAVIDADSi           -7.299e+00  1.068e+00  -6.836 8.82e-12 ***
## SEMSANTASi          -6.358e+00  8.072e-01  -7.877 3.83e-15 ***
## ESCOLARSi           -1.711e+00  9.574e-01  -1.787 0.074014 .  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 9.324 on 7228 degrees of freedom
## Multiple R-squared:  0.8969, Adjusted R-squared:  0.8966 
## F-statistic:  3698 on 17 and 7228 DF,  p-value: < 2.2e-16
Se evalúa el agrupado 2 para determinar si este tiene un mejor ajuste.
#acc_year$PERIODO <- as.numeric(acc_year$PERIODO)
modelo_lm_2<-lm(ACCIDENTES~FECHA+DIA_NOMBRE+PERIODO+CLASE+MES+DIA+COMUNA+FESTIVO+MADRE+NAVIDAD+BRUJITOS+SEMSANTA+ESCOLAR,data=acc_agrupado_2, subset = (FECHA<="2017-12-31"))
summary(modelo_lm_2)
## 
## Call:
## lm(formula = ACCIDENTES ~ FECHA + DIA_NOMBRE + PERIODO + CLASE + 
##     MES + DIA + COMUNA + FESTIVO + MADRE + NAVIDAD + BRUJITOS + 
##     SEMSANTA + ESCOLAR, data = acc_agrupado_2, subset = (FECHA <= 
##     "2017-12-31"))
## 
## Residuals:
##    Min     1Q Median     3Q    Max 
## -7.906 -1.658 -0.210  1.170 35.549 
## 
## Coefficients:
##                              Estimate Std. Error t value Pr(>|t|)    
## (Intercept)                -3.050e+04  1.252e+04  -2.436 0.014840 *  
## FECHA                      -4.232e-02  1.739e-02  -2.434 0.014936 *  
## DIA_NOMBREJUEVES            8.658e-01  4.405e-02  19.657  < 2e-16 ***
## DIA_NOMBRELUNES             8.187e-01  4.477e-02  18.285  < 2e-16 ***
## DIA_NOMBREMARTES            9.247e-01  4.417e-02  20.936  < 2e-16 ***
## DIA_NOMBREMIERCOLES         8.776e-01  4.406e-02  19.918  < 2e-16 ***
## DIA_NOMBRESABADO            7.072e-01  4.401e-02  16.068  < 2e-16 ***
## DIA_NOMBREVIERNES           1.010e+00  4.405e-02  22.936  < 2e-16 ***
## PERIODO                     1.548e+01  6.354e+00   2.436 0.014846 *  
## CLASECAIDA OCUPANTE        -1.801e-01  3.857e-02  -4.670 3.02e-06 ***
## CLASECHOQUE                 3.896e+00  3.292e-02 118.364  < 2e-16 ***
## CLASEINCENDIO              -1.104e+00  6.777e-01  -1.629 0.103225    
## CLASEOTRO                  -8.732e-02  3.742e-02  -2.333 0.019639 *  
## CLASEVOLCAMIENTO           -6.746e-01  4.952e-02 -13.623  < 2e-16 ***
## MES                         1.300e+00  5.293e-01   2.455 0.014085 *  
## DIA                         4.131e-02  1.740e-02   2.374 0.017611 *  
## COMUNAARANJUEZ              1.645e+00  1.499e-01  10.977  < 2e-16 ***
## COMUNABELEN                 2.018e+00  1.503e-01  13.430  < 2e-16 ***
## COMUNABUENOS AIRES          9.004e-01  1.514e-01   5.945 2.77e-09 ***
## COMUNACASTILLA              2.925e+00  1.490e-01  19.629  < 2e-16 ***
## COMUNADOCE DE OCTUBRE       7.325e-01  1.519e-01   4.823 1.42e-06 ***
## COMUNAEL POBLADO            2.974e+00  1.515e-01  19.640  < 2e-16 ***
## COMUNAGUAYABAL              2.303e+00  1.504e-01  15.307  < 2e-16 ***
## COMUNALA AMERICA            7.047e-01  1.529e-01   4.609 4.05e-06 ***
## COMUNALA CANDELARIA         5.855e+00  1.483e-01  39.493  < 2e-16 ***
## COMUNALAURELES              3.665e+00  1.495e-01  24.513  < 2e-16 ***
## COMUNAMANRIQUE              7.541e-01  1.517e-01   4.973 6.61e-07 ***
## COMUNAPALMITAS             -1.431e+00  9.416e-01  -1.520 0.128463    
## COMUNAPOPULAR               4.487e-01  1.570e-01   2.858 0.004264 ** 
## COMUNAROBLEDO               1.833e+00  1.495e-01  12.262  < 2e-16 ***
## COMUNASAN ANTONIO DE PRADO -3.302e-01  1.690e-01  -1.953 0.050783 .  
## COMUNASAN CRISTOBAL         1.195e-01  1.621e-01   0.737 0.461059    
## COMUNASAN JAVIER            3.406e-01  1.548e-01   2.200 0.027795 *  
## COMUNASANTA CRUZ            1.187e-01  1.582e-01   0.751 0.452747    
## COMUNASANTA ELENA           1.452e-01  1.835e-01   0.791 0.429023    
## COMUNAVILLA HERMOSA         5.328e-01  1.528e-01   3.488 0.000488 ***
## FESTIVOSi                  -6.547e-01  7.309e-02  -8.956  < 2e-16 ***
## MADRESi                     4.205e-01  2.236e-01   1.881 0.060009 .  
## NAVIDADSi                  -5.505e-01  1.145e-01  -4.806 1.54e-06 ***
## BRUJITOSSi                  6.275e-02  2.117e-01   0.296 0.766923    
## SEMSANTASi                 -5.307e-01  9.041e-02  -5.870 4.38e-09 ***
## ESCOLARSi                  -1.328e-01  1.017e-01  -1.306 0.191710    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 2.791 on 58670 degrees of freedom
## Multiple R-squared:  0.4389, Adjusted R-squared:  0.4385 
## F-statistic:  1119 on 41 and 58670 DF,  p-value: < 2.2e-16

Agregando la variable de comunas, vemos que el modelo es menos significativo que e agrupado 1 por lo que se opta por hacer la validacion con el modelo del agrupado 1.

Calculo de \(R^2\) Manual de la regresion para comprobar con el función
y0_tr<-mean(acc_agrupado_1$ACCIDENTES[acc_agrupado_1$FECHA<="2017-12-31"])
r0_tr<-acc_agrupado_1$ACCIDENTES[acc_agrupado_1$FECHA<="2017-12-31"]-y0_tr
R0_tr<-mean(r0_tr^2)
y_pred_tr_lm<-predict(modelo_lm_1)
r_tr_lm<-acc_agrupado_1$ACCIDENTES[acc_agrupado_1$FECHA<="2017-12-31"]-y_pred_tr_lm
R_tr_lm<-mean(r_tr_lm^2)
R2_lm<-1-R_tr_lm/R0_tr

print(R2_lm)
## [1] 0.8968859

este da igual.

se procede a hacer un ajuste del modelo Poisson, para esto de calcula un Pseudo \(R^2\)
# ERROR DE AQUI EN ADELANTE
#y_pred_tr_glm<-predict(modelo_glm,type="response")
#r_tr_glm<-acc_agrupado_1$ACCIDENTES[acc_agrupado_1$FECHA<="2017-12-31"]-y_pred_tr_glm
#R_tr_glm<-mean(r_tr_glm^2)
#R2_tr_glm<-1-R_tr_glm/R0_tr
#print(R2_tr_glm)

Este modelo muestra un \(R^2\) superior por lo cuál se usará para hacer las comparaciones de modelos.

Se elabora un DataFrame para poder graficar predichos y observados de los modelos
# resultados_lm_glm<-data.frame(FECHA=  acc_agrupado_1$FECHA[acc_agrupado_1$FECHA<="2017-12-31"],ACCIDENTES=acc_agrupado_1$ACCIDENTES[acc_agrupado_1$FECHA<="2017-12-31"],
#                               pred_lm=y_pred_tr_lm,
#                               pred_glm=y_pred_tr_glm,
#                             res_lm=r_tr_lm,
#                             res_glm=r_tr_glm)
Modelo Arboles Decision BASE 0
library(rpart)
modelo_rpart_0<-rpart(ACCIDENTES~FECHA+CLASE+DISENO+DIA_NOMBRE+PERIODO+FESTIVO+MADRE+NAVIDAD+BRUJITOS+SEMSANTA+ESCOLAR,data=acc_agrupado_0, subset = (FECHA<="2017-12-31"))
print(modelo_rpart_0)
## n= 17234 
## 
## node), split, n, deviance, yval
##       * denotes terminal node
## 
##  1) root 17234 4348807.0000  9.720436  
##    2) DISENO=CICLO RUTA,GLORIETA,INTERSECCION,LOTE O PREDIO,PASO A NIVEL,PASO ELEVADO,PASO INFERIOR,PONTON,PUENTE,TUNEL,VIA PEATONAL 10055  313852.9000  3.975435  
##      4) DISENO=CICLO RUTA,GLORIETA,LOTE O PREDIO,PASO A NIVEL,PASO ELEVADO,PASO INFERIOR,PONTON,PUENTE,TUNEL,VIA PEATONAL 6588   22438.6900  2.202186 *
##      5) DISENO=INTERSECCION 3467  231335.4000  7.344967  
##       10) CLASE=ATROPELLO,CAIDA OCUPANTE,INCENDIO,OTRO,VOLCAMIENTO 2007     906.8919  1.368211 *
##       11) CLASE=CHOQUE 1460   60181.5700 15.560960 *
##    3) DISENO=TRAMO VIA 7179 3238273.0000 17.766960  
##      6) CLASE=ATROPELLO,CAIDA OCUPANTE,INCENDIO,OTRO,VOLCAMIENTO 5718  128893.2000  7.956628 *
##      7) CLASE=CHOQUE 1461  405264.6000 56.162220  
##       14) DIA_NOMBRE=DOMINGO 209   11492.4500 32.086120 *
##       15) DIA_NOMBRE=JUEVES,LUNES,MARTES,MIERCOLES,SABADO,VIERNES 1252  252399.8000 60.181310 *
library(rpart.plot)
rpart.plot(modelo_rpart_0,tweak = 1.2)

summary(modelo_rpart_0)
## Call:
## rpart(formula = ACCIDENTES ~ FECHA + CLASE + DISENO + DIA_NOMBRE + 
##     PERIODO + FESTIVO + MADRE + NAVIDAD + BRUJITOS + SEMSANTA + 
##     ESCOLAR, data = acc_agrupado_0, subset = (FECHA <= "2017-12-31"))
##   n= 17234 
## 
##           CP nsplit rel error    xerror        xstd
## 1 0.40250076      0 1.0000000 1.0000898 0.023939585
## 2 0.03250829      2 0.1949985 0.1950803 0.004253889
## 3 0.02648149      3 0.1624902 0.1626445 0.003648641
## 4 0.01000000      5 0.1095272 0.1097320 0.003142637
## 
## Variable importance
##      CLASE     DISENO DIA_NOMBRE 
##         74         22          4 
## 
## Node number 1: 17234 observations,    complexity param=0.4025008
##   mean=9.720436, MSE=252.3388 
##   left son=2 (10055 obs) right son=3 (7179 obs)
##   Primary splits:
##       DISENO     splits as  LLLLLLLLLRLL, improve=0.183195300, (0 missing)
##       CLASE      splits as  LLRLLL,       improve=0.136632500, (0 missing)
##       FECHA      < 17163.5 to the right,  improve=0.006059356, (0 missing)
##       PERIODO    < 2016.5  to the right,  improve=0.005957862, (0 missing)
##       DIA_NOMBRE splits as  LRRRRRR,      improve=0.003779356, (0 missing)
##   Surrogate splits:
##       CLASE splits as  LRLRRR,      agree=0.628, adj=0.106, (0 split)
##       FECHA < 16141.5 to the right, agree=0.590, adj=0.016, (0 split)
## 
## Node number 2: 10055 observations,    complexity param=0.02648149
##   mean=3.975435, MSE=31.21362 
##   left son=4 (6588 obs) right son=5 (3467 obs)
##   Primary splits:
##       DISENO     splits as  LLRLLLLLL-LL, improve=0.191423500, (0 missing)
##       CLASE      splits as  LLRLLL,       improve=0.133986000, (0 missing)
##       DIA_NOMBRE splits as  LRRRRRR,      improve=0.002791311, (0 missing)
##       FECHA      < 17360.5 to the left,   improve=0.001973797, (0 missing)
##       PERIODO    < 2016.5  to the left,   improve=0.001427046, (0 missing)
##   Surrogate splits:
##       CLASE splits as  RLLLLL,      agree=0.668, adj=0.037, (0 split)
##       FECHA < 16076.5 to the right, agree=0.656, adj=0.001, (0 split)
## 
## Node number 3: 7179 observations,    complexity param=0.4025008
##   mean=17.76696, MSE=451.0758 
##   left son=6 (5718 obs) right son=7 (1461 obs)
##   Primary splits:
##       CLASE      splits as  LLRLLL,      improve=0.835048600, (0 missing)
##       DIA_NOMBRE splits as  LRRRRRR,     improve=0.012244590, (0 missing)
##       FECHA      < 17158.5 to the right, improve=0.004915123, (0 missing)
##       PERIODO    < 2016.5  to the right, improve=0.004789309, (0 missing)
##       FESTIVO    splits as  RL,          improve=0.001704451, (0 missing)
## 
## Node number 4: 6588 observations
##   mean=2.202186, MSE=3.405994 
## 
## Node number 5: 3467 observations,    complexity param=0.02648149
##   mean=7.344967, MSE=66.72496 
##   left son=10 (2007 obs) right son=11 (1460 obs)
##   Primary splits:
##       CLASE      splits as  LLRLLL,      improve=0.7359312000, (0 missing)
##       DIA_NOMBRE splits as  LRRRRRR,     improve=0.0082500230, (0 missing)
##       FECHA      < 17179.5 to the left,  improve=0.0055151280, (0 missing)
##       PERIODO    < 2016.5  to the left,  improve=0.0048665460, (0 missing)
##       NAVIDAD    splits as  RL,          improve=0.0007121953, (0 missing)
##   Surrogate splits:
##       FECHA < 16165.5 to the right, agree=0.589, adj=0.023, (0 split)
## 
## Node number 6: 5718 observations
##   mean=7.956628, MSE=22.54167 
## 
## Node number 7: 1461 observations,    complexity param=0.03250829
##   mean=56.16222, MSE=277.3885 
##   left son=14 (209 obs) right son=15 (1252 obs)
##   Primary splits:
##       DIA_NOMBRE splits as  LRRRRRR,     improve=0.34883940, (0 missing)
##       FESTIVO    splits as  RL,          improve=0.03986503, (0 missing)
##       FECHA      < 17158.5 to the right, improve=0.03572912, (0 missing)
##       PERIODO    < 2016.5  to the right, improve=0.03277970, (0 missing)
##       NAVIDAD    splits as  RL,          improve=0.02784668, (0 missing)
##   Surrogate splits:
##       MADRE splits as  RL, agree=0.86, adj=0.019, (0 split)
## 
## Node number 10: 2007 observations
##   mean=1.368211, MSE=0.4518644 
## 
## Node number 11: 1460 observations
##   mean=15.56096, MSE=41.22026 
## 
## Node number 14: 209 observations
##   mean=32.08612, MSE=54.9878 
## 
## Node number 15: 1252 observations
##   mean=60.18131, MSE=201.5973
y0_tr<-mean(acc_agrupado_0$ACCIDENTES[acc_agrupado_0$FECHA<="2017-12-31"])
r0_tr<-acc_agrupado_0$ACCIDENTES[acc_agrupado_0$FECHA<="2017-12-31"]-y0_tr
R0_tr<-mean(r0_tr^2)

y_pred_tr_rpart<-predict(modelo_rpart_0)
r_tr_rpart<-acc_agrupado_0$ACCIDENTES[acc_agrupado_0$FECHA<="2017-12-31"]-y_pred_tr_rpart
R_tr_rpart<-mean(r_tr_rpart^2)
R2_tr_rpart<-1-R_tr_rpart/R0_tr
print(R2_tr_rpart)
## [1] 0.8904728
Modelo Arboles Decision BASE 1
library(rpart)
modelo_rpart_1<-rpart(ACCIDENTES~FECHA+CLASE+DIA_NOMBRE+PERIODO+FESTIVO+NAVIDAD+SEMSANTA+ESCOLAR,data=acc_agrupado_1, subset = (FECHA<="2017-12-31"))
print(modelo_rpart_1)
## n= 7246 
## 
## node), split, n, deviance, yval
##       * denotes terminal node
## 
## 1) root 7246 6094251.0 23.119240  
##   2) CLASE=ATROPELLO,CAIDA OCUPANTE,INCENDIO,OTRO,VOLCAMIENTO 5785  155757.7  9.521175 *
##   3) CLASE=CHOQUE 1461  633246.9 76.962350  
##     6) DIA_NOMBRE=DOMINGO 209   16374.4 45.306220 *
##     7) DIA_NOMBRE=JUEVES,LUNES,MARTES,MIERCOLES,SABADO,VIERNES 1252  372468.7 82.246810 *
library(rpart.plot)
rpart.plot(modelo_rpart_1,tweak = 1.2)

summary(modelo_rpart_1)
## Call:
## rpart(formula = ACCIDENTES ~ FECHA + CLASE + DIA_NOMBRE + PERIODO + 
##     FESTIVO + NAVIDAD + SEMSANTA + ESCOLAR, data = acc_agrupado_1, 
##     subset = (FECHA <= "2017-12-31"))
##   n= 7246 
## 
##           CP nsplit  rel error     xerror       xstd
## 1 0.87053297      0 1.00000000 1.00020840 0.02178205
## 2 0.04010399      1 0.12946703 0.12967599 0.00423566
## 3 0.01000000      2 0.08936304 0.08945901 0.00350991
## 
## Variable importance
##      CLASE DIA_NOMBRE 
##         96          4 
## 
## Node number 1: 7246 observations,    complexity param=0.870533
##   mean=23.11924, MSE=841.0504 
##   left son=2 (5785 obs) right son=3 (1461 obs)
##   Primary splits:
##       CLASE      splits as  LLRLLL,  improve=0.8705330000, (0 missing)
##       DIA_NOMBRE splits as  LRRRRRR, improve=0.0113070000, (0 missing)
##       FESTIVO    splits as  RL,      improve=0.0014065900, (0 missing)
##       SEMSANTA   splits as  RL,      improve=0.0008808344, (0 missing)
##       NAVIDAD    splits as  RL,      improve=0.0006652363, (0 missing)
## 
## Node number 2: 5785 observations
##   mean=9.521175, MSE=26.9244 
## 
## Node number 3: 1461 observations,    complexity param=0.04010399
##   mean=76.96235, MSE=433.4339 
##   left son=6 (209 obs) right son=7 (1252 obs)
##   Primary splits:
##       DIA_NOMBRE splits as  LRRRRRR,     improve=0.38595340, (0 missing)
##       FESTIVO    splits as  RL,          improve=0.04166331, (0 missing)
##       NAVIDAD    splits as  RL,          improve=0.03167520, (0 missing)
##       SEMSANTA   splits as  RL,          improve=0.02596220, (0 missing)
##       FECHA      < 16530.5 to the left,  improve=0.01585194, (0 missing)
## 
## Node number 6: 209 observations
##   mean=45.30622, MSE=78.34642 
## 
## Node number 7: 1252 observations
##   mean=82.24681, MSE=297.499
y0_tr_1<-mean(acc_agrupado_1$ACCIDENTES[acc_agrupado_1$FECHA<="2017-12-31"])
r0_tr_1<-acc_agrupado_1$ACCIDENTES[acc_agrupado_1$FECHA<="2017-12-31"]-y0_tr_1
R0_tr_1<-mean(r0_tr_1^2)

y_pred_tr_rpart_1<-predict(modelo_rpart_1)
r_tr_rpart_1<-acc_agrupado_1$ACCIDENTES[acc_agrupado_1$FECHA<="2017-12-31"]-y_pred_tr_rpart_1
R_tr_rpart_1<-mean(r_tr_rpart_1^2)
R2_tr_rpart_1<-1-R_tr_rpart_1/R0_tr_1
print(R2_tr_rpart_1)
## [1] 0.910637
Modelo Arboles Decision BASE 2
library(rpart)
modelo_rpart_2<-rpart(ACCIDENTES~FECHA+DIA_NOMBRE+PERIODO+CLASE+MES+DIA+COMUNA+FESTIVO+MADRE+NAVIDAD+BRUJITOS+SEMSANTA+ESCOLAR,data=acc_agrupado_2, subset = (FECHA<="2017-12-31"))
print(modelo_rpart_2)
## n= 58712 
## 
## node), split, n, deviance, yval
##       * denotes terminal node
## 
##  1) root 58712 814606.200  2.853284  
##    2) CLASE=ATROPELLO,CAIDA OCUPANTE,INCENDIO,OTRO,VOLCAMIENTO 37168  26909.850  1.481920 *
##    3) CLASE=CHOQUE 21544 597205.000  5.219179  
##      6) COMUNA=ALTAVISTA,ARANJUEZ,BELEN,BUENOS AIRES,CASTILLA,DOCE DE OCTUBRE,EL POBLADO,GUAYABAL,LA AMERICA,MANRIQUE,PALMITAS,POPULAR,ROBLEDO,SAN ANTONIO DE PRADO,SAN CRISTOBAL,SAN JAVIER,SANTA CRUZ,SANTA ELENA,VILLA HERMOSA 18628 182724.100  3.845287  
##       12) COMUNA=ALTAVISTA,BUENOS AIRES,DOCE DE OCTUBRE,LA AMERICA,MANRIQUE,PALMITAS,POPULAR,SAN ANTONIO DE PRADO,SAN CRISTOBAL,SAN JAVIER,SANTA CRUZ,SANTA ELENA,VILLA HERMOSA 9998  16320.380  2.007902 *
##       13) COMUNA=ARANJUEZ,BELEN,CASTILLA,EL POBLADO,GUAYABAL,ROBLEDO 8630  93547.130  5.973928  
##         26) COMUNA=ARANJUEZ,BELEN,ROBLEDO 4311  25175.230  4.709116 *
##         27) COMUNA=CASTILLA,EL POBLADO,GUAYABAL 4319  54591.640  7.236397  
##           54) DIA_NOMBRE=DOMINGO 588   2936.223  3.743197 *
##           55) DIA_NOMBRE=JUEVES,LUNES,MARTES,MIERCOLES,SABADO,VIERNES 3731  43349.600  7.786920 *
##      7) COMUNA=LA CANDELARIA,LAURELES 2916 154698.000 13.995880  
##       14) COMUNA=LAURELES 1456  28420.440 10.049450 *
##       15) COMUNA=LA CANDELARIA 1460  80987.150 17.931510  
##         30) DIA_NOMBRE=DOMINGO 209   1656.421  7.052632 *
##         31) DIA_NOMBRE=JUEVES,LUNES,MARTES,MIERCOLES,SABADO,VIERNES 1251  50463.190 19.749000 *
library(rpart.plot)
rpart.plot(modelo_rpart_2,tweak = 1.5)

summary(modelo_rpart_2)
## Call:
## rpart(formula = ACCIDENTES ~ FECHA + DIA_NOMBRE + PERIODO + CLASE + 
##     MES + DIA + COMUNA + FESTIVO + MADRE + NAVIDAD + BRUJITOS + 
##     SEMSANTA + ESCOLAR, data = acc_agrupado_2, subset = (FECHA <= 
##     "2017-12-31"))
##   n= 58712 
## 
##           CP nsplit rel error    xerror        xstd
## 1 0.27637543      0 1.0000000 1.0000578 0.017705582
## 2 0.08943783      2 0.4472491 0.4473821 0.006537582
## 3 0.05559786      3 0.3578113 0.3579140 0.006036272
## 4 0.03543742      4 0.3022135 0.3024034 0.004904589
## 5 0.01691647      5 0.2667760 0.2669396 0.004204121
## 6 0.01019611      6 0.2498596 0.2503943 0.004044814
## 7 0.01000000      7 0.2396634 0.2437977 0.003999149
## 
## Variable importance
##     COMUNA      CLASE DIA_NOMBRE 
##         63         31          6 
## 
## Node number 1: 58712 observations,    complexity param=0.2763754
##   mean=2.853284, MSE=13.87461 
##   left son=2 (37168 obs) right son=3 (21544 obs)
##   Primary splits:
##       CLASE      splits as  LLRLLL, improve=0.2338447000, (0 missing)
##       COMUNA     splits as  LLLLRLRLLRRLLLLLLLLLL, improve=0.1100771000, (0 missing)
##       DIA_NOMBRE splits as  LRRRRRR, improve=0.0075000810, (0 missing)
##       FESTIVO    splits as  RL, improve=0.0008081853, (0 missing)
##       NAVIDAD    splits as  RL, improve=0.0005013052, (0 missing)
##   Surrogate splits:
##       COMUNA splits as  LLLLLLLLLLLLRLLRLLLLL, agree=0.635, adj=0.004, (0 split)
## 
## Node number 2: 37168 observations
##   mean=1.48192, MSE=0.7240059 
## 
## Node number 3: 21544 observations,    complexity param=0.2763754
##   mean=5.219179, MSE=27.72025 
##   left son=6 (18628 obs) right son=7 (2916 obs)
##   Primary splits:
##       COMUNA     splits as  LLLLLLLLLRRLLLLLLLLLL, improve=0.434998000, (0 missing)
##       DIA_NOMBRE splits as  LRRRRRR, improve=0.025360560, (0 missing)
##       FESTIVO    splits as  RL, improve=0.002541788, (0 missing)
##       NAVIDAD    splits as  RL, improve=0.001896749, (0 missing)
##       MES        < 1.5     to the left,  improve=0.001536040, (0 missing)
## 
## Node number 6: 18628 observations,    complexity param=0.08943783
##   mean=3.845287, MSE=9.809111 
##   left son=12 (9998 obs) right son=13 (8630 obs)
##   Primary splits:
##       COMUNA     splits as  LRRLRLRRL--LLLRLLLLLL, improve=0.398724600, (0 missing)
##       DIA_NOMBRE splits as  LRRRRRR, improve=0.022372320, (0 missing)
##       FESTIVO    splits as  RL, improve=0.001975984, (0 missing)
##       NAVIDAD    splits as  RL, improve=0.001847804, (0 missing)
##       MES        < 1.5     to the left,  improve=0.001577436, (0 missing)
##   Surrogate splits:
##       FECHA < 16078.5 to the right, agree=0.537, adj=0.001, (0 split)
## 
## Node number 7: 2916 observations,    complexity param=0.05559786
##   mean=13.99588, MSE=53.05142 
##   left son=14 (1456 obs) right son=15 (1460 obs)
##   Primary splits:
##       COMUNA     splits as  ---------RL----------, improve=0.29276640, (0 missing)
##       DIA_NOMBRE splits as  LRRRRRR, improve=0.19844830, (0 missing)
##       FESTIVO    splits as  RL, improve=0.02333334, (0 missing)
##       NAVIDAD    splits as  RL, improve=0.01432906, (0 missing)
##       MES        < 1.5     to the left,  improve=0.01236593, (0 missing)
##   Surrogate splits:
##       DIA_NOMBRE splits as  RRRRRRL, agree=0.501, adj=0.001, (0 split)
##       SEMSANTA   splits as  RL,      agree=0.501, adj=0.001, (0 split)
## 
## Node number 12: 9998 observations
##   mean=2.007902, MSE=1.632364 
## 
## Node number 13: 8630 observations,    complexity param=0.01691647
##   mean=5.973928, MSE=10.83976 
##   left son=26 (4311 obs) right son=27 (4319 obs)
##   Primary splits:
##       COMUNA     splits as  -LL-R-RR------L------, improve=0.147308200, (0 missing)
##       DIA_NOMBRE splits as  LRRRRRR, improve=0.083031400, (0 missing)
##       FESTIVO    splits as  RL, improve=0.008177895, (0 missing)
##       MES        < 1.5     to the left,  improve=0.006373795, (0 missing)
##       FECHA      < 16817.5 to the left,  improve=0.006362978, (0 missing)
##   Surrogate splits:
##       DIA_NOMBRE splits as  LRRRRRL,     agree=0.503, adj=0.005, (0 split)
##       FECHA      < 17069.5 to the left,  agree=0.501, adj=0.001, (0 split)
##       MES        < 4.5     to the left,  agree=0.501, adj=0.001, (0 split)
##       SEMSANTA   splits as  RL,          agree=0.501, adj=0.001, (0 split)
##       DIA        < 30.5    to the right, agree=0.501, adj=0.001, (0 split)
## 
## Node number 14: 1456 observations
##   mean=10.04945, MSE=19.51953 
## 
## Node number 15: 1460 observations,    complexity param=0.03543742
##   mean=17.93151, MSE=55.47065 
##   left son=30 (209 obs) right son=31 (1251 obs)
##   Primary splits:
##       DIA_NOMBRE splits as  LRRRRRR,     improve=0.35644600, (0 missing)
##       FESTIVO    splits as  RL,          improve=0.04606966, (0 missing)
##       NAVIDAD    splits as  RL,          improve=0.02441886, (0 missing)
##       MES        < 1.5     to the left,  improve=0.02016827, (0 missing)
##       SEMSANTA   splits as  RL,          improve=0.01050465, (0 missing)
##   Surrogate splits:
##       MADRE splits as  RL, agree=0.86, adj=0.019, (0 split)
## 
## Node number 26: 4311 observations
##   mean=4.709116, MSE=5.839766 
## 
## Node number 27: 4319 observations,    complexity param=0.01019611
##   mean=7.236397, MSE=12.63988 
##   left son=54 (588 obs) right son=55 (3731 obs)
##   Primary splits:
##       DIA_NOMBRE splits as  LRRRRRR, improve=0.15214440, (0 missing)
##       COMUNA     splits as  ----R-RL-------------, improve=0.04021381, (0 missing)
##       FECHA      < 16817.5 to the left,  improve=0.01464768, (0 missing)
##       FESTIVO    splits as  RL, improve=0.01389541, (0 missing)
##       PERIODO    < 2015.5  to the left,  improve=0.01118320, (0 missing)
##   Surrogate splits:
##       MADRE splits as  RL,          agree=0.867, adj=0.020, (0 split)
##       FECHA < 17530.5 to the right, agree=0.864, adj=0.003, (0 split)
## 
## Node number 30: 209 observations
##   mean=7.052632, MSE=7.92546 
## 
## Node number 31: 1251 observations
##   mean=19.749, MSE=40.33828 
## 
## Node number 54: 588 observations
##   mean=3.743197, MSE=4.993576 
## 
## Node number 55: 3731 observations
##   mean=7.78692, MSE=11.61876
y0_tr_2<-mean(acc_agrupado_2$ACCIDENTES[acc_agrupado_2$FECHA<="2017-12-31"])
r0_tr_2<-acc_agrupado_2$ACCIDENTES[acc_agrupado_2$FECHA<="2017-12-31"]-y0_tr_2
R0_tr_2<-mean(r0_tr_2^2)

y_pred_tr_rpart_2<-predict(modelo_rpart_2)
r_tr_rpart_2<-acc_agrupado_2$ACCIDENTES[acc_agrupado_2$FECHA<="2017-12-31"]-y_pred_tr_rpart_2
R_tr_rpart_2<-mean(r_tr_rpart_2^2)
R2_tr_rpart_2<-1-R_tr_rpart_2/R0_tr_2
print(R2_tr_rpart_2)
## [1] 0.7603366

FALTA

Regresar

2.5. Evaluación del modelo

FALTA

Regresar

2.6. Implementación

FALTA

Regresar

3. Conclusiones

FALTA

Regresar

4. Bibliografía

FALTA

R Markdown


Plotly


LeafLet y archivos espaciales


Shiny


Demás


Regresar